00100		TITLE LOOP	;	SUBROUTINE LOOP(I,J,L,M,N)
00200		ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
00300		ENTRY	SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN
00400		EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
00500		EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,HOMNEW
00600		DEFINE FIXX(N)
00700	<	JUMPGE	N,.+5
00800		MOVNS	N
00900		FIX 	N,233000    
01000		MOVNS	N
01100		CAIA
01200		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01300				;	DIMENSION N(1)
01400	MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13   
01500	J←3  ; WHERE IS THIS USED???
01600	RC←14 ↔ NX←15	;**** AC'S 0,1,2,3,5  ARE USED IN 'PLACE' & 'FINDIT'!!
01700	LOOP:	0		;	DO 1 NN=I+L,J+L,K
01800		MOVE	1,@4(16)
01900		SUB 	1,@3(16) 	; MM IS IN 1
02000		MOVE	2,@(16)
02100		ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
02200		MOVE	3,@1(16)
02300		ADD	3,@3(16)	;J+L
02400		MOVE	4,@2(16)	;K
02500		HRRZI	5,@5(16)		; ADR. OF N
02600		ADDI	2,-1(5)		; N(NN)
02700		ADDI	3,-1(5)
02800		JUMPL	4,LP3		; JUMP IF NEG. INCR.
02900		HRRM	1,.+1		; ADD IN MM 
03000	LP1:	MOVE	6,(2)
03100		MOVEM	6,(2)		;N(NN)=N(NN+MM)
03200		CAIGE	2,(3)
03300		AOJA	2,LP1
03400		JRA	16,6(16)
03500	LP3:	HRRM	1,.+1
03600	LP2:	MOVE	6,(2)		;NEG. INCR.
03700		MOVEM	6,(2)
03800		CAILE	2,(3)
03900		SOJA	2,LP2
04000		JRA 	16,6(16)	;	END
04100	
04200	PLACE:	0	;	FUNCTION PLACE(X)
04300	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
04400	;	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
04500		MOVN	2,@(16) ;	PLACE=R11-ABS(RD-X)
04600		FADR	2,XRN+=3999 	;END
04700		MOVMS	2
04800		MOVE 	0,.COMM.+=12	;R11
04900		FSBR	0,2
05000		JRA	16,1(16)
05100	
05200	FINDIT:	0    ;	FUNCTION FINDIT(N)
05300		SETZ   ;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
05400		HRRZ	1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
05500	;;	HRRZI	2,PTR  ;	FINDIT=0
05600	;;	ADDI	1,(2)  ;	L=PWDS(N)
05700	;;	MOVE	2,-1(1) ;	IF(RN(L+1).NE.1)GO TO 377
05800	;;	FIXX(2)         ;	IF(RN(L+2).EQ.R2)RETURN
05900	;;	HRRZI	3,XRN     ;377	FINDIT=-1
06000	;;	ADDI	3,(2)   ;	END
06100	;;	MOVE 5,(3)   ; RN(L+1)
06200		MOVE 2,PTR-1(1)		;THESE 3 REPLACE ABOVE
06300	;X	FIXX(2)
06400		MOVE 5,XRN(2)
06500		CAME	5,[1.0]
06600		JRST	FNEG
06700		MOVEM	2,PTR+=251   ; SENDS BACK A NUM IN L
06800	;;	MOVE	5,1(3)  ;RN(L+2)
06900		MOVE 5,XRN+1(2)
07000		CAME	5,.COMM.
07100	FNEG:	SETO
07200		JRA	16,1(16)
07300	
07400	DPYNEW:	0    ;	SUBROUTINE DPYNEW
07500		JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
07600		JUMP	[1]    ;	CALL ACCPOG(1)
07700		MOVE	2,DPY+=4251    ;	IF(IGO.GT.0)RETURN
07800		JUMPG	2,DB    ;	CALL DPYOUT(1)
07900		JSA	16,DPYOUT    ;	END
08000		JUMP	[1]
08100	DB:	JRA	16,(16)
08200	
08300	MVBEAM:	0  ;C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
08400		HRRZ	2,(16) ;	SUBROUTINE MVBEAM(R,I,JY,L,W)
08500		MOVE	5,@1(16)  ; I
08600		ADD	2,5  ;C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
08700		ADD	2,@2(16)  ;	DIMENSION R(1)
08800		MOVE	3,-1(2)  ;	Y=R(JY+I)
08900		MOVM	4,3   ;	Z=ABS(Y)
09000		CAMGE	4,[=100.0]  ;	IF(Z.LT.100.)GO TO 1
09100		JRST	MV1
09200		CAML	5,[6]
09300		JRST	MV1	;  IF(I.GT.5)GO TO 1
09400	;C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
09500		JSA	16,AMOD  ;	Y=AMOD(Y,100.)
09600		JUMP	3  
09700		JUMP	[=100.0]  ; 0 HAS Y
09800		MOVE	5,@4(16)  ;	X=Y+W
09900		FADR	5,0
10000		MOVM	6,5  ;	Z=Z-ABS(Y)+ABS(X)
10100		MOVM	7,0 ;C  PUTS ALL INTO POSITIVE
10200		FSBR	4,7
10300		FADR	4,6
10400		SKIPGE 	5  ;	IF(X)Z=-Z
10500		MOVNS	4    ; Z
10600		JRST 	MV2 ;	GO TO 2
10700	MV1:	FADR	3,@4(16)  ;1	Z=Y+W
10800		MOVE	4,3   ; Z NOW IN 4
10900	MV2:	HRRZI	3,@(16) ;2	R(L+I)=Z
11000		ADD	3,@3(16)
11100		ADD	3,@1(16)
11200		MOVEM	4,-1(3)  ; PUT IT IN R(L+I)
11300		JRA	16,5(16)	; END
11400	
11500	MVBX:	0   ;	SUBROUTINE MVBX(I)
11600	;     COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
11700		MOVE	2,@(16)  ;	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
11800		ADD	2,KJY+1 ;	R(L+I)=R8+(R(JY+I)-R4)*RDIS
11900	;;	HRRZI	4,XRN
12000	;;	ADDI	2,(4)
12100	;;	MOVE	3,-1(2)  ; R(JY+I)
12200		MOVE 3,XRN-1(2)
12300		FSBR	3,.COMM.+5
12400		FMPR	3,.COMM.+=25  ; *RDIS
12500		FADR	3,.COMM.+=9   ; +R8
12600		MOVE	2,@(16)
12700		ADD	2,.COMM.+=24   ; + L
12800	;;	ADDI	2,(4)
12900	;;	MOVEM	3,-1(2)    ;R(L+I)
13000		MOVEM 3,XRN-1(2)
13100		JRA	16,1(16)
13200	
13300	JUGGLE:	0    ;	SUBROUTINE JUGGLE
13400	;	IMPLICIT INTEGER(A-Z)
13500	;	REAL PWDS,RN
13600	;	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
13700	;     COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
13800		SOS	PTR+=250	;ITEM=ITEM-1
13900		HRRZI	15,XRN	;	JX=RN(MEDIT)+3   WD CNT OF OLD ITEM
14000	;C  I-IX IS WD CNT OF NEW ITEM
14100		ADD	15,DPY+=4250
14200		MOVE	14,-1(15)
14300		FIXX(14)
14400		ADDI	14,3  		; JX
14500		MOVE	13,PTR+=253	;JY=IX
14600		MOVE	11,PTR+=252	; I
14700		SUB	11,13
14800		SUB	11,14		;Z=I-IX-JX    SPACE CHANGE
14900		JUMPL	11,J2751   	;IF(Z)2751,172,751
15000		JUMPE	11,J172
15100		MOVE	5,PTR+=252 ;751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
15200		SUBI	5,1
15300		MOVE	10,DPY+=4250
15400		ADD	10,14
15500		JSA	16,LOOP
15600		JUMP	5
15700		JUMP	10
15800		JUMP	[-1]
15900		JUMP	11
16000		JUMP	[0]
16100		JUMP	XRN
16200		ADD	13,11		;JY=IX+Z
16300		JRST	J172		;GO TO 172
16400	J2751:	ADD	14,DPY+=4250 ;2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
16500		ADD	14,11
16600		MOVE	5,11
16700		ADD	5,PTR+=253
16800		SOJ	5,
16900		MOVN	10,11
17000		JSA	16,LOOP
17100		JUMP	14
17200		JUMP	5
17300		JUMP	[1]
17400		JUMP	[0]
17500		JUMP	10
17600		JUMP	XRN
17700	;;J172:	HRRZI	12,XRN 		;  172	J=RN(JY)+2
17800	;;	ADDI	12,(13) 		; JY
17900	J172:	MOVE 12,XRN-1(13)
18000	;;	MOVE	12,-1(12) 	;RN(JY)
18100		FIXX(12)
18200		ADDI	12,2		; J IS IN 12
18300		JSA	16,LOOP		;CALL LOOP(0,J,1,MEDIT,JY,RN)
18400		JUMP	[0]
18500		JUMP	12
18600		JUMP	[1]
18700		JUMP	DPY+=4250	; MEDIT
18800		JUMP 	13		; JY
18900		JUMP	XRN
19000		MOVE	12,PTR+=253	; I=IX+Z
19100		ADD	12,11		; Z IS IN 11
19200		MOVEM	12,PTR+=252
19300		MOVE	12,PTR+=250  	; 1751	X=ITEM+1
19400		AOJ	12,	    	; X IS IN 12
19500		HRRZI	13,DPY+=4000   	; JX=WDS(X22+1)-WDS(X22)
19600		ADD	13,DL	
19700		MOVE	14,(13)   	; WDS(X22+1) IN 14  ADR. WDS(X22) IN 13
19800		SUB  	14,-1(13)	;JX IN 14
19900		HRRZI	10,DPY+=4000     	;  J=WDS(X+1)-WDS(X)
20000		ADDI	10,(12)
20100		MOVE	7,(10)		;WDS(X+1)
20200		SUB	7,-1(10)		;J IN 7
20300		MOVEM	7,MVBX		; STORE J
20400		SUB	7,14    	; Y=J-JX
20500		MOVE	14,-1(10)  	;  JX=WDS(X)+Y+1
20600		ADD	14,7
20700		AOJ	14,		; JX IN 14
20800		JUMPL	7,J2851   	;  IF(Y)2851,182,282
20900		JUMPE	7,J182
21000		MOVE	15,(10) ;282  CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
21100		ADDI	15,2	  	; ARG 1
21200		MOVE	6,-1(13) 	;  ARG 2
21300		JSA	16,LOOP
21400		JUMP	15
21500		JUMP	6 
21600		JUMP	[-1]
21700		JUMP	7	  	; Y
21800		JUMP	[0]
21900		JUMP	DPY
22000		JRST	J182   		;  GO TO 182
22100	J2851:	MOVE	14,(13) ;2851  CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
22200		ADD	14,7		;+Y
22300		ADDI	14,1		; ARG 1
22400		MOVE	5,-1(10) 	;WDS(X)
22500		ADD	5,7
22600		ADDI	5,1		; ARG 2
22700		MOVNM	7,MVBEAM	; -Y IS STORED
22800		JSA	16,LOOP
22900		JUMP	14
23000		JUMP	5
23100		JUMP	[1]
23200		JUMP	[0]
23300		JUMP	MVBEAM
23400		JUMP	DPY
23500		MOVE	14,-1(10)  	; WDS(X)   JX=WDS(X)+1
23600		ADDI	14,1		; JX IN 14
23700	J182:	MOVE	5,-1(13)  ;182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
23800		ADDI	5,1   	;WDS(X22)+1
23900		JSA	16,LOOP
24000		JUMP	[1]
24100		JUMP	MVBX
24200		JUMP	[1]
24300		JUMP	5  
24400		JUMP	14 
24500		JUMP	DPY
24600		MOVE	2,DL    	; DO 183 K=X22+1,X
24700	;;	HRRZI	5,DPY+=4000  	; 183	WDS(K)=WDS(K)+Y
24800	;;	ADD	5,2
24900		HRRZI	3,PTR
25000		ADDI	3,(2)
25100	;;	TLC	11,232000	; FLOAT Z
25200	;;	FADR	11,11
25300	J183:	JUMPE	11,J184		;IF(Z.EQ.0)GO TO 184
25400		ADDM 11,(3)		; PWDS(K)=PWDS(K)+Z
25500		AOJ	3,	;UPDATE PWDS AND WDS
25600	J184:	JUMPE	7,J185
25700		ADDM 7,(13)
25800		AOJ 13,
25900	J185:	CAIGE	2,(12)
26000		AOJA	2,J183
26100	;;	HRRZI	2,DPY+=4000	;ST(2)=WDS(X)
26200	;;	ADDI	2,(12)		;WDS(X+1) ADR.
26300	;;	MOVE	2,-1(2)
26400		MOVE 2,DPY+=3999(12)
26500	;;	HRRZI	3,DPY
26600	;;	MOVEM	2,1(3)
26700		MOVEM 2,DPY+1
26800		SETZM	DL		;X22=0
26900		JRA	16,(16)
27000	
27100	SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
27200		MOVEI	2,2	;DIMENSION RPOS(2,200)
27300	S3:	MOVE	6,2	;(K=L HERE)
27400		SETO	11,	;L=2
27500		HRRZI	3,@(16)	;3	J=-1
27600		MOVE	4,2	;RX=RPOS(1,L-1)
27700		SUBI	4,1	;L-1
27800		IMULI	4,2
27900		ADDI	4,(3)
28000		MOVE	5,-2(4)	;RX
28100	S2:	MOVE 	7,6	;	DO 2 K=L,M
28200	;;	LSH	7,1	;IF(RPOS(1,K).GE.RX)GO TO 2
28300		IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
28400		ADDI	7,(3)
28500		CAMG	5,-2(7)
28600		JRST	S1	; CONTINUE
28700		MOVE	5,-2(7)	;  RX=RPOS(1,K)
28800	;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
28900		MOVE 	11,6	;J=K
29000	S1:	CAMGE	6,@1(16)	;2	CONTINUE
29100		AOJA	6,S2
29200		JUMPL	11,S4	;IF(J)GO TO 4
29300		MOVE	12,2	;K=L-1
29400		SOS	12
29500		IMULI	12,2	;(K*2)
29600		ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
29700		MOVE	10,-2(12)
29800	;;	LSH	11,1		;MULTS BY 2 (LEFT SHIFT)
29900		IMULI	11,2
30000		ADD	11,3
30100		EXCH	10,-2(11)
30200		MOVEM	10,-2(12)
30300		MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
30400		EXCH	10,-1(11)
30500		MOVEM	10,-1(12)
30600	S4:	CAMGE	2,@1(16)	;4	L=L+1
30700		AOJA	2,S3		;IF(L.LE.M)GO TO 3
30800		JRA	16,2(16)	;END
30900	
31000	XNOTE:	0		;FUNCTION XNOTE(J)
31100		MOVE 	3,@(16)		;COMMON/XRN/RN(4000)
31200		IMULI	3,12		;DIMENSION R(10,80)
31300	;;	ADDI	3,XRN+=2993	;EQUIVALENCE (R,RN(3001))
31400	;;	MOVE	2,(3)		;XNOTE=AMOD(R(4,J),100.)
31500		MOVE 2,XRN+=2993(3)
31600		JSA	16,AMOD
31700		JUMP	2
31800		JUMP	[=100.0]
31900		JRA	16,1(16)	;END
32000	
32100	BAUTO:	0		;	SUBROUTINE BAUTO(J,L,K,N)
32200				;C  FOR AUTOMATIC BEAMS.
32300		MOVEI 2,2 	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
32400		ADDB 2,@(16)		;J=J+2
32500	;;	MOVE	3,@3(16)
32600		MOVE	4,@1(16)
32700		SUB	4,@3(16)	;L-N
32800		MOVE	5,@2(16)
32900		SUB	5,@3(16)	;K-N
33000	;;	HRRZI	6,SCM
33100	;;	ADDI	6,(2)
33200		TLC	4,232000
33300		FADR	4,4		;FLOATS IT
33400		MOVEM	4,SC+16(2)		;VX(J-1)=L-N
33500	;;	MOVEM 4,SCM-2(2) ****** WAS V(J-1)
33550	;**** A LIMIT OF 25 BEAMS PER LINE.
33600		TLC	5,232000
33700		FADR	5,5		;FLOATS IT
33800		MOVEM	5,SC+17(2)		;VX(J)=K-N
33900	;;	MOVEM 5,SCM-1(2)
34000		JRA	16,4(16)
34100	
34200	UPDATE:	0	;	SUBROUTINE UPDATE(I)
34300	;;	HRRZI	3,XRN  ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
34400	;;	ADD	3,PTR+=252	;RN(IS)=I
34500		MOVE 3,PTR+=252
34600		MOVE	2,@(16)
34700		TLC	2,232000	;FLOAT I
34800		FADR	2,2
34900	;;	MOVEM	2,-1(3)
35000		MOVEM 2,XRN-1(3)
35100	;;	MOVE	2,PTR+=252
35200	;;	ADD	2,@(16)
35300	;;	ADDI	2,3
35400	;;	MOVEM	2,PTR+=252	;IS=IS+I+3
35500		MOVE 2,@(16)
35600		ADDI 2,3
35700		ADDM 2,PTR+=252
35800		JRA	16,1(16)
35900	
36000	IK:	0	;***** DON'T USE THESE ELSEWHERE, THEY STORE NUMBS.!!
36100	JIT:	0  ; THESE ARE TO STORE PNTRS IN LOOP
36200	NEWR:	0	;	SUBROUTINE NEWR
36300		MOVE	A,SC+=70	;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
36400		CAIE	A,1		;COMMON/XRN/RN(4000)
36500		JRST	N1	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
36600		MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
36700		MOVEM JK,IK  ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
36800		MOVE JT,PTR+=250  ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
36900	 	MOVEM	JT,JIT  	;DIMENSION R(10,80)	
37000	N1:	MOVE	IS,IK		;EQUIVALENCE (R,RN(3001))
37100		MOVEM	IS,PTR+=252
37200		MOVE 14,[9999.0]
37300		MOVE 	JT,JIT		;IF(MODE.NE.1)GO TO 1
37400		ADDI	JT,1		;IK=IS
37500		MOVEM	JT,PTR+=250	;JIT=ITEM
37600		MOVEI	K,=10		;1	IS=IK
37700		MOVE	IZ,SCX+=41	;ITEM=JIT+1 ******************** WAS +=33
37800		IMULI	IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
37900	;;N2:	HRRZI	R,XRN+=2997	;DO 2 K=1,IZ
38000	;;;;N2:	MOVE	R,XRN+=2997(K)	;DO 2 K=1,IZ
38100	;;	ADD	R,K		;IF(R(8,K).EQ.9999.)GO TO 2
38200	;;	MOVE	R,(R)
38300	;;;;	CAMN	R,[=9999.0]
38400	N2:	CAMN 14,XRN+=2997(K)
38500		JRST	NN2  ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
38600		SETO	IEND,		;C  JUMP FOR BEAM CONT.
38700	;;	HRRZI	L,XRN		;IEND=-1
38800	;;	ADD	L,PTR+=252	;RN(IS+3)=0
38900	;;	SETZM	2(L)
39000	;;	SETZM	1(L)		;RN(IS+2)=0
39100		MOVE L,PTR+=252
39200		SETZM XRN+2(L)
39300		SETZM XRN+1(L)
39400		MOVEI	L,=9 ;C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
39500	;;N3:	HRRZI	R,XRN+=3000	;DO 3 L=9,1,-1
39600	N3:	HRRZI	R,XRN+=3000(K)	;DO 3 L=9,1,-1
39700	;;	ADDI	R,(K)		;A=R(L,K)
39800		ADDI	R,(L)
39900		MOVE	A,-13(R)	;(OCTAL)=-11
40000		JUMPGE	IEND,NX4	;IF(A.NE.0)GO TO 77
40100		JUMPN	A,NX3		;IF(IEND)GO TO 3
40200		JRST	NN3
40300	NX3:	MOVE	IEND,L		;77	IF(IEND)IEND=L
40400	;;NX4:	HRRZI	R,XRN
40500	;;	ADD	R,PTR+=252	;RN(IS+L)=A
40600	;;	ADDI	R,(L)
40700	;;	MOVEM	A,-1(R)
40800	NX4:	MOVE R,PTR+=252
40900		ADDI R,(L)
41000		MOVEM A,XRN-1(R)
41100	NN3:	CAILE	L,1		;3	CONTINUE
41200		SOJA	L,N3
41300		CAIGE	IEND,3
41400		MOVEI	IEND,3
41500		MOVE	15,IEND		;IF(IEND.LT.3)IEND=3
41600		SUBI	15,2
41700		JSA 	16,UPDATE	;CALL UPDATE(IEND-2)
41800		JUMP	15
41900	NN2:	CAML	K,IZ		;2	CONTINUE
42000		JRA	16,(16)		;END
42100		ADDI	K,=10
42200		JRST	N2
42300	
42400	CNT:	0
42500	MSSLUP:	0
42600		SETZ	1,		;161	CNT=1
42700		SETZ	2,
42800	L5543:	MOVE	3,.COMM.+4(2)	;DO 5543 K=1,9
42900	;;	ADDI	3,(2)
43000	;;	MOVE	3,(3)		;RA=RJQ(K)
43100		SKIPE	3		;IF(RA.NE.0)CNT=K
43200		MOVE	1,2
43300	;;	MOVEI	4,RRJJ+1	;5543	RJJ(K)=RA
43400	;;	ADDI	4,(2)
43500	;;	MOVEM	3,(4)
43600		MOVEM 3,RRJJ+1(2)
43700		CAIG	2,7		; LOOP BACK?
43800		AOJA	2,L5543
43900		AOJ	1,
44000		MOVEM	1,CNT		;REMEMBERS CNT
44100		JRA	16,(16)
44200	
44300	LUP2:	0
44400	;;	MOVEI	1,XRN		;261	RN(I)=CNT
44500	;;	ADD	1,PTR+=252
44600		MOVE	2,CNT
44700		TLC	2,232000
44800		FADR	2,2		;FLOATS IT
44900	;;	MOVEM	2,-1(1)
45000		MOVE 1,PTR+=252
45100		MOVEM 2,XRN-1(1)
45200		MOVE	2,.COMM.+1	;RN(I+1)=JA
45300		TLC	2,232000
45400		FADR	2,2
45500	;;	MOVEM	2,(1)
45600	;;	MOVE	2,PTR+=252	;I=I+2
45700	;;	ADDI	2,2
45800	;;	MOVEM	2,PTR+=252
45900		MOVEM 2,XRN(1)
46000		ADDI 1,2
46100		MOVEM 1,PTR+=252
46200		MOVE	3,.COMM.	;RN(I)=R2
46300	;;	MOVEM	3,1(1)
46400		MOVEM 3,XRN-1(1)
46500	;; NOT USED NOW!	IF(RD.NE.0)RN(I)=RD
46600	;;C TO SAVE NOTE NUMBS IN P2.
46700		SETZ	5,		;DO 4554 K=1,CNT
46800	L4554:	MOVE 2,.COMM.+4(5)
46900	;;L4554:	MOVEI	2,.COMM.+4	;(RJQ)
47000	;;	ADDI	2,(5)
47100	;;	MOVE	2,(2)
47200	;;	MOVEI	3,XRN(5)
47300	;;	ADDI	3,(5)
47400	;;	ADD	3,PTR+=252
47500	;;	MOVEM	2,(3)		;4554	RN(I+K)=RJQ(K)
47600		MOVE 3,1
47700		ADDI 3,(5)
47800		MOVEM 2,XRN(3)
47900		AOJ	5,
48000		CAME	5,CNT
48100		JRST	L4554
48200		AOJ	5,
48300	;;	ADD	5,PTR+=252
48400		ADDM 5,PTR+=252
48500	;;	MOVEM	5,PTR+=252	;3554	I=CNT+1+I
48600		JRA	16,(16)
48700	
48800	;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
48900	;;	SUBROUTINE HOMER
49000	;;	IMPLICIT INTEGER(A-Q,S-Z)
49100	;;	REAL PWDS,DISX,A,B,PLACE,STFF
49200	;;	COMMON /STF/RSTFAC(-3/4),RSTJ2
49300	;;    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
49400	;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
49500	;;	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
49600	;;	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
49700	;;	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
49800	;;	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
49900	HOMER:	0		; IF(JA.EQ.6)GO TO 9
50000		MOVE	MM,.COMM.+1
50100		CAIN	MM,6
50200		JRST	H9
50300		SKIPE	.COMM.+=14	;IF(R13.NE.0)GO TO 10
50400		JRST	H10	; FOR GENL HOMING; WORDS;  BEAMS;  STEMS;
50500		MOVE RC,[6.0]	;RC=6  USE THIS NEXT AND AT 197
50600		SKIPN	.COMM.+=24	;IF(J3.EQ.0)GO TO 197
50700		JRST	H197	; NEXT TO HOME IN ON NOTE ON DIFFERENT STAFF.
50800	
50900		MOVE PTR+=250		;JJ2=ITEM (FOR RETURN WITH NO CHANGE)
51000		MOVEM POSI+=8
51100				; IF(JA.EQ.6)GO TO 9
51200		MOVE	K,.COMM.	;JJ2=R2
51300		FIXX(K)
51400		MOVE	K,PTR-1(K)	;K=PWDS(J2) ← BEAM PTR.
51500	;;	MOVE XRN(K)
51600	;;	CAME [6.0]	; IS IT REALLY A BEAM?
51700		CAME RC,XRN(K)	; IS IT REALLY A BEAM?
51800		JRA 16,(16)	;NO - GO BACK
51900	;******* 19, ITEM# OF BEAM, +1 FOR STAFF ABOVE, -1 FOR BELOW.
52000		MOVEM K,.COMM.+3	;SAVES IT IN J2
52100		MOVE R,XRN+5(K) ; POS OF RT. SIDE OF BEAM SAVED IN R
52200		SETZ MM,	; 0=BEAM STEM ↓
52300		MOVE XRN+6(K)	;RN(K+7)  STEM DIR.
52400		CAMGE [20.0]	;IS IT UP?
52500		SETO MM,	; YES    -1=BEAM STEM ↑
52600		MOVEM MM,ALF+=21	;SAVE IT 'TIL AFTER AMOD
52700		MOVE A,XRN+1(K)		;SAVE BEAM'S STAFF #
52800		MOVEM A,ALF+8
52900		MOVE 5,A
53000		MOVE .COMM.+4		; 2ND PARAM
53100		CAMN [0.1]	; USE .1 FOR SAME STAFF
53200		SETZ 
53300		MOVEM .COMM.+4
53400		FADR A,
53500		MOVEM A,ALF+5	; SAVE NOTES' STAFF #
53600		SETZ L,		; NEXT IS SEARCH LOOP
53700		MOVE IZ,[1.0]
53800	;;	MOVE NN,.COMM.+5 ;IF(R4.EQ.0)R4=3.0   SETS HOMING RANGE
53900		SKIPN NN,.COMM.+5
54000		MOVE NN,[3.0]
54100	H401:	MOVE JK,PTR(L)	; JK=KWDS(L)
54200		CAMN 5,XRN+1(JK)	;IF RN(JK).NE.STF, SKIP
54300		JRST .+3
54400		CAME A,XRN+1(JK)	 ; LOOKS ON BOTH STAVES FOR END NOTE OF BEAM
54500		JRST H402
54600		CAME IZ,XRN(JK)	; IS IT A NOTE?
54700		JRST H402	; NO
54800		MOVE XRN+2(JK)	;POS OF NOTE
54900		FSBR R	; NOTE POS - RT. SIDE OF BEAM
55000		MOVM		; ABS. VALUE
55100		CAMG NN	 	;  3.0 RANGE FOR HOMING  - P4
55200		JRST H403	; NO CLOSE ENOUGH
55300	H402:	AOJ L,		; ADD ONE FOR LOOP
55400		CAMGE L,PTR+=250	; UP TO ITEM YET?
55500		JRST H401
55600	
55700		JRA 16,(16)	;COULDN'T HOME IN.
55800	H403:	MOVEM JK,ALF	; FOR JK=KWDS(L) -- NT PTR. SAVE IT FOR HOMNEW
55900		MOVE NX,[1.0]
56000		MOVE XRN+3(JK)	;RN(JK+4) NOTE HGT.
56100		CAML [80.0]
56200		MOVE NX,[0.6]	; MINI-NOTE
56300		MOVEM NX,STF+=8		; PUT IT IN RSTJ2
56400	
56500		SETZM ALF+=17	;NOTE STEM -- 0=↓
56600		MOVE XRN+4(JK)  ;RN(JK+5)
56700		CAMGE [20.0]
56800		SETOM ALF+=17	;  STEM  -- -1=↑
56900		MOVE	0,XRN+6(K)	;RG=-(AMOD(RN(K+7),10.)-1.)[*NX]*11./7.
57000		MOVEM	0,ALF+=13		;RN(K+7)
57100		JSA	16,AMOD
57200		JUMP	ALF+=13
57300		JUMP	[=10.0]
57400		FSBR	0,[=1.0]
57500		FMPR	0,[=1.5714]
57600		FMPR 0,NX	; *RMINI (.6)
57700		MOVEM	0,ALF+=15		;RG SAVED IN ALF+=15
57800	;   VERTICAL SPACE FOR THE NUMB. OF BEAMS
57900		MOVE JK,ALF+8		;GET BEAM'S STAFF #
58000		FIXX(JK)		; JK IS IN JK
58100		MOVEM JK,ALF+=8		;SAVE IT
58200	;  THE STAFF NUMS.  JK=BEAM   JT=NOTE
58300		MOVE	IS,STF+3(JK)	;R3=RSTFAC(JK)  R3 IS IN 'IS'
58400		FMPR IS,NX	; *RMINI (.6)
58500	;;	MOVE	IZ,STF+3(JT)	;R9=RSTFAC(JT)/R3
58600		FMPR	IS,[=2.43959732]	;R8=R3*14.54/5.96
58700		MOVEM IS,ALF+=14
58800	;  R8=WIDTH OF NOTE
58900	
59000	;************************************************
59100		MOVE MM,ALF+5
59200		FIXX(MM)		; THESE FOR FORTR. ROUTINE
59300		MOVEM MM,ALF+5
59400		JSA 16,HOMNEW	;CALL FORTRAN ROUTINE FOR NOW.
59500		JRA 16,(16)
59600	
59700	
59800	
59900	;  ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
60000	;  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
60100	H197:	SETOM POSI+=8		;197	JJ2=-1
60200		MOVE	R,.COMM.		;R3=R2
60300		MOVEM	R,DPYNEW
60350		MOVE IZ,[6.0]
60400		SETZ	K,		;DO 191 K=1,ITEM
60500	H191:	MOVEM	K,LOOP		;SAVE K       	L=PWDS(K)
60600		MOVE	L,PTR(K)	; L IS PWDS(K+1)
60700			;IF(RN(L+1).NE.6)GO TO 191
60800		MOVEI	R,XRN(L)
60900		CAME IZ,(R)
61000	;;	MOVE	A,(R)
61100	;;	CAME	A,[=6.0]
61200		JRST	HX191
61300		MOVE	JK,DPYNEW		;IF(RN(L+2).EQ.R3)GO TO 77
61400		CAMN	JK,1(R)
61500		JRST	H77
61600		CAMGE	JK,[=5.0]	;IF(R3.LT.5.)GO TO 191
61700		JRST 	HX191		; TYPE 19 99 FOR ALL STAVES
61800	H77:	MOVE	JK,-1(R)		;77
61900		CAMN	JK,[=8.0]	;IF(RN(L).EQ.8)GO TO 191
62000		JRST	HX191
62100		MOVE	JK,6(R)		;IF(RN(L+7).LT.10.)GO TO 191
62200		CAMGE	JK,[=10.0]	;C  FINDS BEAMS.
62300		JRST	HX191
62400		FDVR	JK,[=10.0]	;X=RG/10.
62500		FIXX(JK)			;C  STEM DIRECT.
62600		MOVEM	JK,XNOTE		;X SAVED IN XNOTE
62700		MOVE	JK,1(R)		;R2=RN(L+2)
62800		MOVEM	JK,.COMM.	; USED IN 'FINDIT'
62900		MOVE	A,2(R)		;A=RN(L+3)-.01
63000		FSBR	A,[=0.01]
63100		MOVEM	A,NEWR		;SAVE A IN NEWR
63200		MOVM RC,3(R)	;RC=ABS(RN(L+4))   RC USED AFTER H192
63300		FSBR RC,[90.0]	;NEG=MAXI SIZE,  POS=MINI SIZE BEAMS.
63400		MOVE	JK,5(R)		;B=RN(L+6)+.01
63500		FADR	JK,[=0.01]	;C  POS 1 AND 2
63600		MOVEM	JK,BAUTO		;B SAVED IN BAUTO
63700		FSBR	JK,A		;DISX=B-A
63800		MOVEM	JK,UPDATE	;DISX SAVED IN UPDATE
63900	;  DISTANCE IN REAL STEPS
64000		MOVEM	R,MVBX		;SAVE LOC OF RN(L+1)
64100		MOVE	0,3(R)
64200		MOVEM	0,JUGGLE
64300		JSA	16,AMOD		;RF=AMOD(RN(L+4),100.0)
64400		JUMP	JUGGLE 
64500		JUMP	[=100.0]
64600		MOVEM	0,JUGGLE; THIS IS RF!!!!
64700	;  NOTE 2
64800		MOVE	JK,MVBX 
64900		MOVE	JK,4(JK)
65000		MOVEM	JK,MSSLUP
65100		JSA	16,AMOD		;RB=AMOD(RN(L+5),100.0)
65200		JUMP	MSSLUP 
65300		JUMP	[=100.0]	;0 WILL HAVE RB!!!
65400		FSBR	0,JUGGLE 
65500		MOVEM	0,SORT2 		;RD SAVED IN ALF+=9  --  RD=RB-RF
65600		MOVEI NX,1
65700	H192:	JSA	16,FINDIT	;IF(FINDIT(N))GO TO 192
65800		JUMP	NX
65900		JUMPL	0,HX192
66000		MOVEI	R,XRN		;IF(RN(L).EQ.8)GO TO 192
66100		ADD	R,PTR+=251	;LOC OF RN(L+1)
66200		MOVE	JK,-1(R)
66300		CAMN	JK,[=8.0]
66500		JRST	HX192
66510		JUMPGE RC,.+4	;JUMP IF MINI-BEAMS. THEY WILL LOOK FOR MININOTES
66600		MOVE	JK,7(R)		;IF(RN(L+8).GE.1000.)GO TO 192
66700		CAML	JK,[=1000.0]
66800		JRST	HX192	; SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
66900	;  FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
67000		MOVE	A,2(R)		;RC=RN(L+3)
67100		CAMGE	A,NEWR		;IF(RC.LT.A)GO TO 192
67200		JRST	HX192
67300		CAMLE	A,BAUTO		;IF(RC.GT.B)GO TO 192
67400		JRST	HX192	;  WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
67500		MOVE	JK,4(R)		;IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
67600		FDVR	JK,[=10.0]
67700		FIXX(JK)
67800		CAME	JK,XNOTE
67900		JRST	HX192
68000		FSBR	A,NEWR		;RC=RC-A
68100		MOVEM	A,MVBEAM;SAVES RC
68200		MOVEM	R,MVBX 		;SAVE LOC OF RN(L+1)
68300		MOVE 	0,3(R)
68400		MOVEM	0,MSSLUP
68500		JSA	16,AMOD		;193	RE=AMOD(RN(L+4),100.0)
68600		JUMP	MSSLUP
68700		JUMP	[=100.0]
68800		MOVEM	0,ALF+3		;RE SAVE HERE
68900		MOVE	JK,SORT2 		;RC=RD*RC/DISX+RF
69000		FMPR	JK,MVBEAM	;*RC
69100		FDVR	JK,UPDATE 	;/DISX
69200		FADR	JK,JUGGLE 	;+RF
69300		MOVEM	JK,MVBEAM	;RC=
69400		MOVE	JK,MVBX
69500		MOVE	JK,6(JK)		;RG=RN(L+7)
69600		MOVEM	JK,ALF+4		;SAVE RG
69700		JSA	16,AMOD		;RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
69800		JUMP	ALF+4
69900		JUMP	[=10.0]
70000		MOVEM	0,LUP2
70100		JSA	16,AMOD
70200		JUMP	ALF+4
70300		JUMP	[=1.0]
70400		FSBR	0,LUP2
70500		FADR	0,ALF+4
70600		MOVE	L,MVBX
70700		MOVEM	0,6(L) ;DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
70800	;  FRACTIONAL NOTE #
70900		MOVE	R,MVBEAM	;195	RA=RC-RE
71000		FSBR	R,ALF+3
71100		MOVE	JK,XNOTE		;IF(X.EQ.2)RA=-RA
71200		CAIN	JK,2
71300		MOVNS	R
71400	;;	SKIPN	R		;IF(RA.EQ.0)RA=999.
71500	;;	MOVE	R,[=999.0]
71510		MOVE 0,7(L)	;IF(RN(L+8).GT.999)RA=RA+1000.  FOR MINI-NOTES
71520		CAMLE 0,[999.0]
71530		FADR R,[1000.0]
71600		MOVEM	R,7(L)		;196	RN(L+8)=RA
71700	;  FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
71800		SKIPGE	POSI+=8
71900		MOVEM	NX,POSI+=8	;  SAVES # OF LOWEST ITEM FOUND
72000	HX192:	CAMGE	NX,PTR+=250	;192	CONTINUE
72100		AOJA	NX,H192
72200	HX191:	MOVE	K,LOOP		;191	CONTINUE
72300		CAMGE K,PTR+=250
72400		AOJA K,H191
72500		JRA	16,(16)		;RETURN
72600	H9:	SKIPGE	.COMM.+=32	;9	IF(J11.LT.0)RETURN
72700		JRA	16,(16)		;   IF P11=-1 NO HOMING
72800		MOVE	R,.COMM.+=8	;	X=R7/10.
72900		FDVR	R,[=10.0]
73000		FIXX(R)
73100		SKIPGE	R		;IF(X)X=-X
73200		MOVNS	R
73300		MOVEM	R,XNOTE		;X SAVED IN XNOTE
73400	;  X IS STEM DIRECTION
73500		MOVE	L,.COMM.+=10	;RA=R9
73600	;  R9= POS3
73700		MOVNI	RC,1	;RC=-1 
73800		SKIPE	L		;IF(R9.NE.0)RC=-2
73900		MOVNI	RC,2
74000		MOVE	JK,.COMM.+=31	;IF(J10/10.EQ.3)RC=-3
74100		IDIVI	JK,=10		;JT HAS REMAINDER (AC4)
74200		CAIN	JK,3
74300		MOVNI	RC,3		;  RC=0 ESCAPES FRCOM LOOP.
74400	;;;	JRST	HZ10
74500	;;;H10:	SETZ	RC,		;FOR P13=1
74600	;   HOMING RANGE FOR BEAMS
74700	;;;HZ10:	MOVE	IS,.COMM.+=12	;10	IF(R11.EQ.0)R11=2.9
74800	H10:	MOVE	IS,.COMM.+=12	;10	IF(R11.EQ.0)R11=2.9
74900		JUMPN	IS,HX10
75000		MOVE	IS,[=2.9]
75100		MOVEM	IS,.COMM.+=12	;   IF P11.NE.0 RANGE IS CHANGED FROM 2
75200	HX10:	MOVE	IZ,.COMM.+1	;	IF(JA.EQ.5)RC=-1
75300		CAIN	IZ,5
75400		MOVNI	RC,1
75500		MOVEI	K,1
75600	H361:	JSA	16,FINDIT		;DO 361 K=1,ITEM
75700		JUMP	K
75800		JUMPL	0,HX361		;IF(FINDIT(K))GO TO 361
75900	;  SKIPS NOTES ON WRONG LINE 
76000		MOVEI	R,XRN		;RD=RN(L+3)
76100		ADD	R,PTR+=251	;LOC OF RN(L+1)
76200		MOVE	A,2(R)		;RD IN A
76300		MOVEM	A,XRN+=3999	;1	IF(JA.NE.6)GO TO 177
76700		MOVE	JK,4(R)		;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
76720		MOVE	.COMM.+1
76760		CAIE	6
76770		JRST	H177
76800		FDVR	JK,[=10.0]
76900		FIXX(J)
77000		CAME	JK,XNOTE
77100		JRST	HX361
77200	H177:	JSA	16,PLACE	;177	IF(PLACE(R3))GO TO 461
77300		JUMP	.COMM.+4
77400		JUMPL	H461
77500		MOVEM	A,.COMM.+4	;R3=RD
77600	;  LOOKS FOR NOTE, STAFF #, STEM DIR.
77610		MOVN .COMM.+=14		;P13=-1 HOME TO NOTE SIDE, =-2 TO STEM.
77620		SKIPG			;IS IT NEG.
77630		JRST H11		; NO, GO TO NEXT SECTION.
77640		MOVE IS,3(R)	; VERTICAL POS OF NOTE (P4)
77660		CAME [1.0]	;IS P13 -1 OR -2?
77670		JRST H12	;IT'S -2
77680		MOVE [2.0]
77690		CAMGE JK,[20.0]		;WHICH WAY IS STEM?
77700		MOVNS
77705		FADR IS		;ADD NOTE LEVEL
77710		MOVEM .COMM.+5		;P4=NOTE LEVEL + OR - 2.
77720		JRST H11
77730	H12:	MOVE IZ,7(R)	; STEM LENGTH
77740		CAMN IZ,[999.0]   ; WHAT ABOUT 16TH AND 32ND NOTES??
77750		SETZ IZ,
77760		FADR IZ,[8.0]
77764		JSA 16,AMOD
77766		JUMP 6(R)
77768		JUMP [10.0]	;AC0=AMOD(R7,10.0)
77769		SKIPN
77771		JRST H13
77773		FSBR [1.0]	;IGNORE 1ST TAIL
77774		FMPR [1.8]	; *SPACE FOR EACH TAIL
77776		FADR IZ,	; ADD TO STEM LENGTH
77784	H13:	CAML JK,[20.0]
77786		MOVNS IZ	;PUT IT UPSIDE DOWN.
77790		FADR IS,IZ	;ADD NOTE LEVEL
77800		MOVEM IS,.COMM.+5	;PUT IT BEYOND STEM
78010	H11:	MOVE	JK,.COMM.+1	;IF(JA.EQ.6)GO TO 861
78020		CAIN	JK,6
78030		JRST	 H861
78040		CAIN	JK,5		;IF(JA.EQ.5)GO TO 261
78100		JRST	H261
78200		JRA	16,(16)		;RETURN
78300	H461:	MOVE	JK,.COMM.+1	;461	IF(JA.EQ.6)GO TO 277
78400		CAIN	JK,6
78500		JRST	H277
78600		CAIE	JK,5		;IF(JA.NE.5)GO TO 361
78700		JRST	HX361
78800	H277:	JSA	16,PLACE	;277	IF(PLACE(R6))GO TO 561
78900		JUMP	.COMM.+7
79000		JUMPL	H561
79100		MOVEM	A,.COMM.+7	;R6=RD
79200	H861:	MOVE	0,.COMM.+=28	;861	IF(J7.GE.0)GO TO 261
79300		JUMPGE	0,H261
79400	H561:	JSA	16,PLACE	;561	IF(PLACE(RA))GO TO 661
79500		JUMP	L
79600		JUMPL	H661
79700		MOVE	0,.COMM.+=28	;IF(J7)GO TO 761
79800		JUMPL	H761	;  J7=NEG MEANS TREMOLO
79900		MOVE	0,.COMM.+=9	;	IF(R8.NE.0)GO TO 761
80000		JUMPN	H761
80100		MOVE	0,.COMM.+=11	;	IF(R10.EQ.0)GO TO 361
80200		JUMPE	HX361
80300	H761:	MOVEM	A,.COMM.+=10	;761	R9=RD
80400	;  R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.
80500		JRST	H261		;GO TO 261
80600	H661:	CAIN	JK,5		;661	IF(JA.EQ.5)GO TO 361
80700		JRST	HX361
80800		MOVE	0,.COMM.+=31	;IF(J10.LT.30)GO TO 361
80900		CAIGE	0,=30
81000		JRST	HX361
81100		JSA	16,PLACE	;IF(PLACE(R8))GO TO 361
81200		JUMP	.COMM.+=9
81300		JUMPL	HX361	; HOMES INNER PARTIAL BEAMS
81400		MOVEM	A,.COMM.+=9	;R8=RD
81500	H261:	SKIPN	RC       	;261	IF(RC.EQ.0)RETURN
81600		JRA	16,(16)    
81700		AOJ	RC		;RC=RC+1
81800	HX361:	CAMGE	K,PTR+=250	;361 	CONTINUE
81900		AOJA	K,H361
82000		JRA	16,(16)		;	END
82100	
82200	;	CALL FSCAN
82300	;	GOTO RT
82400	;	GOTO LF
82500	;	GOTO UP
82600	;	GOTO DW
82700	;	GOTO 1/2
82800	;	GOTO *2
82900	;	GOTO X
83000	;	GOTO C
83100	;	ALL OTHERS(EXIT)
83200	
83300	FSCAN:	0
83400		INCHRW
83500		CAIN ";"
83600		JRA 16,(16)
83700		CAIN ":"
83800		JRA 16,1(16)
83900		CAIN "("
84000		JRA 16,2(16)
84100		CAIN ")"
84200		JRA 16,3(16)
84300		CAIN "/"
84400		JRA 16,4(16)
84500		CAIN "*"
84600		JRA 16,5(16)
84700		CAIN "X"
84800		JRA 16,6(16)
84900		CAIN "C"
85000		JRA 16,7(16)
85100		JRA 16,8(16)
85200		END